perm filename PLOUX.OLX[PIC,LCS] blob sn#081727 filedate 1974-01-17 generic text, type T, neo UTF8
00100		SUBROUTINE PLOU
00200	
00300		COMMON/PLT/JX,JY,JPL,PLT,REV,RINV,IROT,RLR,RUD,CONST
00400		1 ,JREV,JINV,KA,KB,KC,KD,RTO,JA,JB,JAR,JBR,A
00500	
00600		DIMENSION IDP1(4000),INP(10,20)
00700	  
00800		COMMON /LISTC/LIST(6,1000),LIST5(0/1000),NEWEND,LO
00900		COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
01000		1 LSIDE,RSIDE,DTA,HYSTAB(1)
01100		INTEGER FLINE,RSIDE
01200		DATA NEWX/0/,NCNT/0/
01300		RTO=6
01400		NX=0
01500		NY=0
01600		JPL=1
01700	
01800	1001	FORMAT(A1,9F)
01900	1000	FORMAT(' D(ISPLAY) P(LOT) OR M(OVE)?  HORIZ.%,VERT.%,
02000		1 FOR CLEAR AREA L-R-BOT-TOP%   REV=1, INV=1'/)
02200	1	CALL JZERO
02210		JX=0
02220		JY=0
02300		TYPE 1000
02400		ACCEPT 1001,WHICH,RLR,RUD,A,B,C,D,REV,RINV,ROT
02500		IF(WHICH.NE.'T')GO TO 3002
02600		DO 4002 K=1,NCNT
02700	4002	TYPE 5002,(INP(NA,K),NA=1,10)
02800		GO TO 1000
02900	3002	IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
03000		REREAD 3,(INP(NA,NCNT),NA=1,10)
03100		WX=WHICH
03200	C  SO IT WON'T COUNT RETRIES.
03300	3	FORMAT(10A5)
03400	5002	FORMAT(1X10A5)
03500	C  FAC=SIZE BY 100'S, RLR=LEFT-RIGHT SIZE, RUD=UP-DOWN SIZE
03600	C-- D 0 0    0,50,0,50 CLEARS LOWER LFT QUAD. 50 100 50 100 UPR RT.
03700	C  TYPE 'T' TO GET BACK ALL INPUT LINES.
03800		IF(A+B+C+D.EQ.0)A=-1.
03900	C 'N'= PLOT, BUT NO X
04000		IF(WHICH.EQ.'M')GO TO 2002
04100		IF(RLR.EQ.0)RLR=100.
04200		IF(RUD.EQ.0)RUD=100.
04300		IROT=-1
04400		IF(ROT.EQ.0)GO TO 2002
04500		IROT=0
04600		RINV=RINV-1
04700	2002	RLR=RLR/100.
04800		RUD=RUD/100.
04900		IF(WHICH.NE.'D')GO TO 1002
05000		PLT=0
05100		JPL=3
05200	C  DPY IS 1/3 SIZE OF PLOT.
05300		GO TO 2000
05400	
06000	1102	IF(WHICH.NE.'M')GO TO 1000
06200	C  MOVE PEN, L-R%, U-D
06300	2200	RX=JQC-JQA+.5
06400		RY=JQD-JQB+.5
06500		NX=RX*RLR
06600		NY=RY*RUD
06700		RLR=.01
06800		RUD=.01
06900		GO TO 67
07000	
07010	1002  IF(WHICH.NE.'P'.AND.WHICH.NE.'N')GO TO 1102
07032		PLT=1
07054		JPL=1
07076		IF(NEWX.NE.-1)CALL PLOTS(I)
07100	2	IF(WHICH.EQ.'N')GO TO 2000
07200		CALL PLOT(10,0,3)
07300	C  MAKES AN X
07400		CALL PLOT(-10,0,2)
07500		CALL PLOT(0,10,3)
07600		CALL PLOT(0,-10,2)
07700		CALL PLOT(0,0,3)
07800	
07900	2000	IF(NEWEND.GT.1000) PAUSE 'NEWEND>1000'
08000	C NEXT KEEPS ORIG. SIZE FACTORS
08100	50	FORMAT(' DO YOU WANT THE FRAME ?'/)
08200		IF(PLT.EQ.0)GO TO 67
08300	60	TYPE 50
08400	65	FORMAT(' LFT=',I4,'   RT=',I4,'   BOT=',I4,'   TOP=',I4)
08500		ACCEPT 1001,ALFAB
08600	67	RA=LSIDE*(RTO*RLR)+.5
08700		RB=FLINE*(RTO*RUD)+.5
08800		RC=RSIDE*(RTO*RLR)+.5
08900		RD=LLINE*(RTO*RUD)+.5
09000		IF(NEWX.EQ.-1)GO TO 655
09100		JQA=RA
09200		JQB=RB
09300		JQC=RC
09400		JQD=RD
09500	655	JQX=NX
09600		JQY=NY
09700	CC	NY=NY+120-RB
09800	CC	NX=NX+36-RA
09810		NX=NX-368*(1.-RLR)
09820		NY=NY-160*(1.-RUD)
09900	C "ORIGINAL" POS IS SET 1ST TIME ONLY.
10000		JA=RA+NX
10100		JB=RB+NY
10200		JC=RC+NX
10300		JD=RD+NY
10400		IF(WHICH.EQ.'M')GO TO 671
10500		TYPE 657
10600	657	FORMAT(' OUTER LIMITS')
10700		TYPE 65,JA,JC,JB,JD
10800	C   OUTER COORDINATES
10900	CC	JREV=(JA+JC)/JPL
11000	CC	JINV=(JB+JD)/JPL
11010		JREV=((JC-JA)/(JPL*2)+JA/JPL-380)*2
11020		JINV=((JD-JB)/(JPL*2)+JB/JPL-200)*2
11100		KA=0
11200		KB=0
11300		KC=0
11400		KD=0
11500		IF(A)GO TO 671
11600		KA=JA+(JC-JA)*(A/100.)
11700		KB=JA+(JC-JA)*(B/100.)
11800		KC=JB+(JD-JB)*(C/100.)
11900		KD=JB+(JD-JB)*(D/100.)
12000		IF(KB.LT.KA.OR.KD.LT.KC)GO TO 1
12100		TYPE 656
12200	656	FORMAT(/' CLEAR AREA')
12300		TYPE 65,KA,KB,KC,KD
12400	C  CLEAR AREA COORDINATES
12500	671	NA=(JC-JA+2)/3
12600		NB=(JD-JB+2)/3
12700		NC=(JA+2)/3-380
12800		ND=(JB+2)/3-200
12900		IF(NEWX.NE.-1)CALL DPYSET(1,IDP1,4000)
13000		CALL SETPOG(1)
13100		CALL TYPLOC(-300,-611)
13200		CALL DPYBRT(6)
13250		CALL AIVECT(0,0)
13300		MA=JA
13400		MB=JB
13460		JA=NC
13470		JB=ND
13500		IF(IROT)GO TO 672
13600	CC	NC=NX+(JA-JB)*3
13700	CC	NX=NY+(JB-JA)*3
13710		NC=NX-624
13720		NX=NY+624
13730	C  624=208*3
13750		NY=NC
13800	CC	JY=NY/JPL
13850	CC	JX=NX/JPL
13875		CALL EXCH(JA,JB)
13900	C ROTATE THE FRAME TO LEFT 90 DEG.
14000	672	CALL LINES(3)
14100		CALL JZERO
14300		JA=NA
14400		JB=0
14500		CALL LINES(2)
14600		JA=0
14700		JAR=0
14800		JB=NB
14900		CALL LINES(2)
15000		JA=-NA
15100		JB=0
15200		JBR=0
15300		CALL LINES(2)
15400		JA=0
15500		JAR=0
15600		JB=-NB
15700		CALL LINES(2)
15800		JA=MA
15900		JB=MB
16000		JBR=0
16100		CALL DPYOUT(1)
16200		IF(WHICH.NE.'M')GO TO 2683
16300	168	NY=JQY
16400		NX=JQX
16500		GO TO 1
16600	2683	IF(A)GO TO 1683
16700		NA=KA/3-380
16800		NB=KB/3-380
16900		NC=KC/3-200
17000		ND=KD/3-200
17050		GO TO 4683
17100		NPL=1
17200		IF(JPL.EQ.1)NPL=3
17300		IF(REV.EQ.0)GO TO 3683
17400		NA=JREV/NPL-NA
17500		NB=JREV/NPL-NB
17600	3683	IF(RINV.EQ.0)GO TO 4683
17700		NC=JINV/NPL-NC
17800		ND=JINV/NPL-ND
17900	4683	CALL DPYSET(2,LIST5,100)
18000		CALL DPYBRT(2)
18110		JA=NA
18120		JB=NB
18130		JAR=NC
18140		JBR=ND
18200		CALL LINES(0)
18310		JA=NB
18320		JB=ND
18330		CALL LINES(2)
18335		CALL JZERO
18340		JA=NA
18400		CALL LINES(2)
18500		CALL JZERO
18510		JB=NC
18520		CALL LINES(2)
18600		CALL JZERO
19100	6683	CALL DPYOUT(2)
19150		IF(PLT.NE.0)JPL=1
19200		KA=KA/JPL
19300		KB=KB/JPL
19400		KC=KC/JPL
19500		KD=KD/JPL
19600	1683	TYPE 683
19700	683	FORMAT(' OK?'/)
19800		ACCEPT 1001,NA
19900		IF(NA.EQ.'N')GO TO 168
19910		JX=NX/JPL
19920		NEWX=-1
19930		JY=NY/JPL
19940		JA=MA
19950		JB=MB
20000		IF(PLT.NE.0)GO TO 1681
20100	6852	CALL CLRPOG(2)
20200		CALL SETPOG(1)
20300	CC	JA=-380
20400	CC	JB=-200
20410		CALL JZERO
20520		CALL AIVECT(0,0)
20620	CC	IF(IROT)GO TO 684
20670	CC	JA=(RA+RD)/3.-380.
20695	CC	JB=200.-(RB+RC)/3.
20720	CC	CALL EXCH(JA,JB)
20800	CC684	ALL LINES(3)
20900	681	GO TO 685
20950	1681	PLT=-1
21000		IF(ALFAB.EQ.'N') GOTO 685
21060		JA=MA
21080		JB=MB
21100		NA=JA
21200		NB=JB
21300		CALL LINES(3)
21400		JA=JC
21500		CALL LINES(2)
21600		JB=JD
21700		CALL LINES(2)
21800		JA=NA
21900		CALL LINES(2)
22000		JB=NB
22100		CALL LINES(2)
22150	68	GO TO 685
22200		IF(IROT)GO TO 685
22300		NA=(JC-MA)/2-(JD-MB)/2
22400		NX=NX+NA
22500		NY=NY+NA
22600		CALL EXCH(NX,NY)
22930	685	JAR=0
22940		JBR=0
23000		CALL PLTMAN
23100		NX=JQX
23200		NY=JQY
23300		WX=0
23400		END